home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / More Macros < prev    next >
Text File  |  1995-08-02  |  8KB  |  342 lines
  1. procedure ShowTime(nPixels, startTicks: integer);
  2. var
  3.   time: real;
  4.   cr: string;
  5. begin
  6.   time := (TickCount - StartTicks) / 60;
  7.   cr := chr(13);
  8.   PutMessage(nPixels:1, ' pixels', cr, time:1:2, ' seconds',
  9.      cr, nPixels/time:1:0, ' pixels/second');
  10. end;
  11.  
  12. macro 'Fast Invert';
  13. var
  14.   width, height, StartTicks: integer;
  15. begin
  16.   GetPicSize(width,height);
  17.   StartTicks := TickCount;
  18.   Invert;
  19.   ShowTime(width*height, StartTicks);
  20. end;
  21.  
  22. macro 'Slow Invert';
  23. {
  24. This macro illustrates why it's not a good idea to use
  25. macros for pixel-by-pixel processing.
  26. }
  27. var
  28.   width,height,value,x,y,StartTicks: integer;
  29. begin
  30.   GetPicSize(width,height);
  31.   if width = 0 then begin
  32.      beep;
  33.      PutMessage('Image required.');
  34.      exit;
  35.   end;
  36.   StartTicks := TickCount;
  37.   for y:=0 to height-1 do begin
  38.     GetRow(0,y,width);
  39.     for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x];
  40.     PutRow(0,y,width);
  41.   end;
  42.   ShowTime(width*height, StartTicks);
  43. end;
  44.  
  45. macro 'Real Slow Invert';
  46. {
  47. This macro illustrates why it's better to use GetRow
  48. and PutRow instead of GetPixel and PutPixel.
  49. }
  50. var
  51.   width,height,value,x,y,StartTicks: integer;
  52. begin
  53.   GetPicSize(width,height);
  54.   if width = 0 then begin
  55.      beep;
  56.      PutMessage('Image required.');
  57.      exit;
  58.   end;
  59.   StartTicks := TickCount;
  60.   for y:=0 to height-1 do
  61.     for x:=0 to width-1 do PutPixel(x, y, 255-GetPixel(x,y));
  62.   ShowTime(width*height, StartTicks);
  63. end;
  64.  
  65. macro '(---'; begin end;
  66.  
  67. macro 'Show Status [S]';
  68. var
  69.   roiType: integer;
  70. begin
  71.   NewTextWindow('Status');
  72.   writeln('MaxMeasuements = ', Get('MaxMeasurements'):1);
  73.   writeln('UndoBufSize = ', Get('UndoBufSize')/1024:1,'K');
  74.   writeln('FreeMem = ', Get('FreeMem')/1024:1,'K');
  75.   writeln('MaxBlock = ', Get('MaxBlock')/1024:1,'K');
  76.   roiType := Get('RoiType');
  77.   write('RoiType: ');
  78.   if roiType = 0 then write('No ROI or no image')
  79.   else if roiType = 1 then write('rectangle')
  80.   else if roiType = 2 then write('ellipse')
  81.   else if roiType = 3 then write('polygon')
  82.   else if roiType = 4 then write('freehand')
  83.   else if roiType = 5 then write('traced')
  84.   else if roiType = 6 then write('straight line')
  85.   else if roiType = 7 then write('freehand line')
  86.   else if roiType = 8 then write('segmented line');
  87. end
  88.  
  89. macro 'Draw Vertical Calibration Bar';
  90. var
  91.   left,top,width,height,i,x,y2,inc:integer;
  92.   y:real;
  93. begin
  94.   GetRoi(left,top,width,height);
  95.   if width=0 then begin
  96.     beep;
  97.     PutMessage('Make a rectangular selection first.');
  98.     exit;
  99.   end;
  100.   SetFont('Helvetica');
  101.   SetFontSize(10);
  102.   SetText('Plain; Left; no background');
  103.   SetLineWidth(1);
  104.   Setforeground(255);
  105.   DrawScale;
  106.   x:=left;
  107.   y:=top;
  108.   inc:=height/10;
  109.   for i:=1 to 11 do begin
  110.     MoveTo(x+width+10,round(y)+2);
  111.     y2:=round(y);
  112.     if i=11 then y2:=y2-1;
  113.     write(cvalue(GetPixel(x,y2)):1:2);
  114.     y:=y+inc;
  115.   end;
  116. end;
  117.  
  118. macro 'ASCII Dump';
  119. {
  120. Generates an alphanumeric listing of pixels values starting at
  121. the upper left corner of the current selection. 20 rows and 44 columns
  122. can be displayed with the default 552 x 436 window.
  123. }
  124. var
  125.   image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  126.   h,v,value,MaxWidth,MaxHeight,width,height:integer;
  127. begin
  128.   image:=PicNumber;
  129.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  130.   if roiWidth=0 then begin
  131.     beep;
  132.     PutMessage('This macro requires a rectangular selection.');
  133.     exit;
  134.   end;
  135.   SetForegroundColor(255);
  136.   SetBackgroundColor(0);
  137.   MakeNewWindow('ASCII Dump');
  138.   dump:=PicNumber;
  139.   GetPicSize(width,height);
  140.   MaxWidth:=width div 24 - 2;
  141.   MaxHeight:=height div 9 - 3;
  142.   if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  143.   if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  144.   SetFont('Monaco');
  145.   SetFontSize(9);
  146.   SetText('With background; Left Justified');
  147.   MoveTo(2,12);
  148.   write('    ');
  149.   for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  150.   writeln;
  151.   writeln;
  152.   for v:=roiTop to roiTop+roiHeight-1 do begin
  153.     write(v:3,' ');
  154.     for h:=roiLeft to roiLeft+roiWidth-1 do begin
  155.       ChoosePic(image);
  156.       value:=GetPixel(h,v);
  157.       ChoosePic(dump);
  158.       write(value:4);
  159.     end;
  160.     writeln;
  161.   end;
  162.   ChoosePic(image);
  163. end;
  164.  
  165.  
  166. macro 'Scale and Rotate All';
  167. {
  168. Resizes and/or rotates all currently open widows. For example,
  169. change the  ScaleAndRotate command below to
  170. ScaleAndRotate(2,2,0)  to change the size of all the images
  171. in a movie loop sequence from 128 x 128 to 256 x 256.
  172. }
  173. var
  174.   i:integer;
  175. begin
  176.   SaveState;
  177.   SetScaling('Bilinear; Create New Window');
  178.   for i:=1 to nPics do begin
  179.     ChoosePic(1);
  180.     ScaleAndRotate(1.9,1.9,0);
  181.     ChoosePic(1);
  182.     Close;
  183.   end;
  184.   for i:=1 to nPics do begin
  185.     ChoosePic(i);
  186.     SetPicName(i);
  187.   end;
  188.   RestoreState;
  189. end;
  190.  
  191.  
  192. macro 'Dispose All';
  193. begin
  194.   DisposeAll;
  195. end;
  196.  
  197. macro 'Average two Images';
  198.   {Generates the arithmetic average of two images.}
  199. begin
  200.   RequiresVersion(1.53);
  201.   if nPics<>2 then begin
  202.     PutMessage('This macro requires exactly two image windows to be open.');
  203.     Exit;
  204.   End;
  205.   ImageMath('add' ,1 ,2, 0.5, 0, 'Average');
  206.  end;
  207.  
  208.  
  209. macro 'Make Montage [M]';
  210. {Opens a new window and creates in it a composite image made from all}
  211. {currently open images. All the images must be the same size.}
  212. var
  213.   width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  214.   RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  215.   montage,temp:integer;
  216.   scale:real;
  217.   SameSize:boolean;
  218. begin
  219.   nWindows:=nPics;
  220.   SameSize:=true;
  221.   GetPicSize(width,height);
  222.   for i:=1 to nPics do begin
  223.     SelectPic(i);
  224.     GetPicSize(w,h);
  225.     SameSize:=SameSize and (w=width) and (h=height);
  226.   end;
  227.   if (nWindows<2) or not SameSize then begin
  228.     PutMessage('This macro needs two or more images of the same size in order to create a montage.');
  229.     Exit;
  230.   end;
  231.   SetBackground(0);
  232.   MakeNewWindow('Montage');
  233.   montage:=nWindows+1;
  234.   GetPicSize(mWidth,mHeight);
  235.   SelectPic(1);
  236.   Duplicate('Temp');
  237.   temp:=nWindows+2;
  238.   scale:=GetNumber('Scaling Factor:',0.25);
  239.   hloc:=-(RoiWidth);
  240.   vloc:=0;
  241.   for i:=1 to nWindows do begin
  242.     SelectPic(i);
  243.     SelectAll;
  244.     copy;
  245.     SelectPic(temp);
  246.     paste;
  247.     SelectAll;
  248.     ScaleSelection(scale,scale);
  249.     RestoreRoi;
  250.     if i=1 then begin
  251.       GetRoi(left,top,RoiWidth,RoiHeight);
  252.       hloc:=-RoiWidth;
  253.       vloc:=0;
  254.     end;
  255.     Copy;
  256.     SelectPic(montage);
  257.     hloc:=hloc+RoiWidth;
  258.     if (hloc+RoiWidth)>mWidth then begin
  259.       hloc:=0;
  260.       vloc:=vloc+RoiHeight;
  261.     end;
  262.     MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  263.     Paste;
  264.   end;
  265.   KillRoi;
  266.   SelectPic(temp);
  267.   Dispose;
  268. end;
  269.  
  270.  
  271. macro 'Make Sine Wave';
  272. var
  273.   left,top,width,height,i:integer;
  274.   ppp,scale:real;
  275. begin
  276.   SaveState;
  277.   MakeNewWindow('Sine Wave');
  278.   SelectAll;
  279.   GetRoi(left,top,Width,Height);
  280.   if width=0 then begin
  281.     PutMessage('This macro requires a rectangular selection.');
  282.     Exit;
  283.   end;
  284.   ppp:=GetNumber('Pixels per period',100);
  285.   Scale:=ppp/6.28;
  286.   MakeRoi(left,top,1,height);
  287.   for i:=1 to width do begin
  288.     SetForeground(sin(i/scale)*127 +128);
  289.     {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
  290.     {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);}
  291.     fill;
  292.     MoveRoi(1,0);
  293.   end;
  294.   KillRoi;
  295.   RestoreState;
  296. end;
  297.  
  298. macro 'Beep if No Selection [B]';
  299. var 
  300.   left,top,width,height:integer;
  301. begin
  302.   GetRoi(left,top,width,height);
  303.   if width=0 then beep;
  304. end;
  305.  
  306. macro 'Exponent Demo╔';
  307. var
  308.     base,ex, result:real;
  309. begin
  310.     base:=GetNumber('Base:', 2);
  311.     ex:=GetNumber('Exponent:', 5);
  312.     result:=exp(ln(base)*ex);
  313.     PutMessage(result:6:3);
  314. end;
  315.  
  316. macro 'Convert Number to String Test╔';
  317. var
  318.     n: real;
  319.     s1, s2, s3, s4: string;
  320. begin
  321.     n:=GetNumber('Enter a Number', 12.345);
  322.     s1 := concat(n);
  323.     s2 := concat(n:1:2);
  324.     s3 := concat(n:10:4);
  325.     s4 := concat(n:0);
  326.     PutMessage('s1=',s1,', s2=',s2,', s3=',s3', s4=',s4);
  327. end;
  328.  
  329.  
  330. macro '(---'; begin end;
  331.  
  332. {These macros allow you to easily switch}
  333. {transfer modes while pasting by tapping keys.}
  334. macro 'Copy Mode[1]'; begin SetOption; DoCopy; end;
  335. macro 'AND Mode[2]';  begin SetOption; DoAnd; end;
  336. macro 'OR Mode [3]';  begin SetOption; DoOr; end;
  337. macro 'XOR Mode[4]'; begin SetOption; DoXor; end;
  338. macro 'REPLACE Mode[5]';  begin SetOption; DoReplace; end;
  339. macro 'BLEND [6]';  begin SetOption; DoBlend; end;
  340. macro 'Terminate Paste [7]'; begin KillRoi end;
  341.  
  342.